SPACE 2/SPACE - Library 2 - Volume 1.iso/music/7/pascal/strval.pas

Pascal/Delphi Source File | 1985-11-19 | 7.1 KB | 330 lines

{*  THIS IS A PROGRAM, TAKE OUT THE MAIN ROUTINE TO USE JUST THE FUNCTIONS *}

Program LalaBlahLala(InThoughTheOutDoor,OutThroughTheInDoor);

Var
  TestSt:  String;
  TestRl:  Real;


{***
 *   Floating Point Conversion routines.
 *   From Real to String and String to Real
 *
 *   By Kevin L. McGrath
 ***}

PROCEDURE Str(Value: Real; VAR St: String);

{* Notes:
 *   This routine is only accurate up to 9 digits becuase of the LongTrunc.
 *   It HAD rounding errors, but they are now fixed (with the LongTrunc)
 *
 * O.S.S. Pascals Floating Point Format:
 *   This is just a guess, but here goes...
 *   One byte of exponent biased by 128 to give a +38 to -38 range.
 *   Fourty bits of mantissa to give 11 digits of accuracy, One bit sign.
 *   Most floating points are normalized to the left, with the point between
 *   the most significant bit of the mantissa and the second most, so I think
 *   this is two.  To find out, just plug out a routine that has a pointer
 *   to a real, coerce's it into a pointer to a record structure of byte like
 *   this:
 *     Record
 *       Exponent:      Byte;
 *       MantissaOne:   Long;
 *       MantissaTwo:   Long;
 *       MantissaThree: Long;
 *     End;
 *   then you can extract the exponent and mantissa just by doing a
 *   "Ptr.Exponent" or somethin like that.  Well, I haven't had time to get
 *   that fancy with this, but I have used this routine and am sure it works.
 *   Hope you guys at O.S.S. can vert it to some kind of normal ASM function!
 *      Good Luck...   (Nice Compiler)
 *      Call me if there are any probs, dig?
 *}


Const
  Max_Digits    = 09;
  Max_Exponent  = 38;

Var
  Val:          Real;
  TempInt,
  Sig_Digits,
  Dec_Exp,
  I:            Integer;
  Digits:       String;

Begin
  Val := Abs(Value);
  Dec_Exp := 0;

  {* Get the exponent without Natural Log (Ln doesn't seem to work fer me) *}

  If (Val < 1) And (Val > 0) Then
  Begin
    For I := 0 To (Max_Exponent-1) Do
      If (Val < (1/PwrOfTen(I))) And (Val >= (1/PwrOfTen(I+1))) Then
        Dec_Exp := -(I+1);
    Val := Val * PwrOfTen(Abs(Dec_Exp)-1);
  End
  Else
  Begin
    For I := 0 To (Max_Exponent-1) Do
      If (Val >= PwrOfTen(I)) And (Val < PwrOfTen(I+1)) Then
        Dec_Exp := I;
    Val := Val / PwrOfTen(Dec_Exp+1);
  End;

{ Get decimal digits by stripping }

  Digits := '';
  St := '';

  For I := Max_Digits DownTo 1 Do
  Begin
    { Take care of rounding problems }

    Val := Long_Trunc(Val*PwrOfTen(I)+0.5)/PwrOfTen(I);

    Val := Val*10.0;
    Digits := ConCat(Digits,Chr(48+Trunc(Val)));
    Val := Val-Trunc(Val);

    { Take care of rounding problems }

    Val := Long_Trunc(Val*PwrOfTen(I)+0.5)/PwrOfTen(I);

  End;

{ Format and put result in St }
{ Put sign }

  If Value < 0 Then St := '-';

{ Compute significant digits }

  Sig_Digits := Max_Digits;
  I := Max_Digits - 1;
  While ((Digits[I]='0') And (I>0)) Do
  Begin
    Sig_Digits := Sig_Digits - 1;
    I := I - 1;
  End;
  Sig_Digits := Sig_Digits - 1;

{ Put in exponential or non-exonential }

  If ((Sig_Digits-Max_Digits)<=Dec_Exp) And (Dec_Exp<=Max_Digits) Then
  Begin
    { Non-exponental form }
    { Put decimal point and leading zeros for numbers with negative exponents }

    If Dec_Exp < 0 Then
    Begin
      St := ConCat(St,'.');
      For I := 1 To -Dec_Exp-1 Do
        St := ConCat(St,'0');
    End;

    { Put significant digits }

    St := ConCat(St,Digits[1]);
    For I := 1 To Sig_Digits-1 Do
    Begin
      If Dec_Exp = 0 Then
        St := ConCat(St,'.');
      St := ConCat(St,Digits[I+1]);
      Dec_Exp := Dec_Exp - 1;
    End;

    { Put trailing zeros }

    While Dec_Exp > 0 Do
    Begin
      St := ConCat(St,'0');
      Dec_Exp := Dec_Exp - 1;
    End;
  End
  Else
  Begin
    { Exponental form }
    { Put first digit }

    St := ConCat(St,Digits[1]);

    { Put decimal point }

    If Sig_Digits > 1 Then
      St := ConCat(St,'.');

    { Put remaining significant digits }

    For I := 1 To (Sig_Digits - 1) Do
      St := ConCat(St,Digits[I+1]);

    { Put the 'E' for the exponent }

    St := ConCat(St,'E');

    { Put exponents sign }

    If Dec_Exp >= 0 Then
      St := ConCat(St,'+')
    Else
    Begin
      St := ConCat(St,'-');
      Dec_Exp := Abs(Dec_Exp);
    End;

    { Put the exponent }

    If Dec_Exp >= 10 Then
    Begin
      St := ConCat(St,Chr(48+(Dec_Exp Div 10)));
      St := ConCat(St,Chr(48+Dec_Exp-((Dec_Exp Div 10) * 10)));
    End
    Else
    Begin
      St := ConCat(St,'0');
      St := ConCat(St,Chr(48+Dec_Exp));
    End;
  End;
End;


FUNCTION Val( St: String): Real;

Const
  Max_Digits    = 09;

Var
  Dec_Exp,
  Exp_Value,
  Count,
  Position:     Integer;
  Chr:          Char;
  Result:       Real;
  Dec_Sign,
  Exp_Sign:     Boolean;

  PROCEDURE Add_Digit;

  Begin
    Result := (Result * 10) + (Ord(Chr) & $0F);
  End;

  PROCEDURE Read_Chr;

  Begin
    Position := Position + 1;
    If Position > Length(St) Then
      Chr := 'X'
    Else
      Chr := St[Position];
  End;

Begin
  Position := 0;
  Read_Chr;
  Result := 0.0;

{ Get sign }

  Dec_Sign := False;
  If Chr = '+' Then Read_Chr;
  If Chr = '-' Then
  Begin
    Read_Chr;
    Dec_Sign := True;
  End;

{ Get digits to left of decimal point }

  Dec_Exp := 0;
  Count := Max_Digits;
  While ('0' <= Chr) And (Chr <= '9') Do
  Begin
    If Count > 0 Then
    Begin
      Add_Digit;
      Count := Count - 1;
    End
    Else
      Dec_Exp := Dec_Exp + 1;
    Read_Chr;
  End;

{ Get digits to the right of decimal point }

  If Chr = '.' Then
  Begin
    Read_Chr;
    While ('0' <= Chr) And (Chr <= '9') Do
    Begin
      If Count > 0 Then
      Begin
        Add_Digit;
        Dec_Exp := Dec_Exp - 1;
        Count := Count - 1;
      End;
      Read_Chr;
    End;
  End;

{ Get exponent part }

  If (Chr = 'E') Or (Chr = 'e') Then
  Begin
    Read_Chr;
    Exp_Sign := False;
    If Chr = '+' Then Read_Chr;
    If Chr = '-' Then
    Begin
      Read_Chr;
      Exp_Sign := True;
    End;
    Exp_Value := 0;
    If ('0'<=Chr) And (Chr<='9') Then Exp_Value := (Ord(Chr) & $0F)*10;
    Read_Chr;
    If ('0'<=Chr) And (Chr<='9') Then Exp_Value := Exp_Value+(Ord(Chr) & $0F);
    If (Chr = 'X') And (Exp_Value >= 10) Then Exp_Value := Exp_Value Div 10;
    If Exp_Sign Then
      Dec_Exp := Dec_Exp - Exp_Value
    Else
      Dec_Exp := Dec_Exp + Exp_Value;
  End;

{ Multiply or divide Result by power of 10 specified by Dec_Exp }

  If Dec_Exp > 0 Then
    Result := Result * PwrOfTen(Dec_Exp)
  Else
    Result := Result / PwrOfTen(Abs(Dec_Exp));

  If Dec_Sign Then Result := -Result;

  Val := Result;

End;


{*  MAIN ROUTINE  *}

Begin
  TestRl := 0.0;
  While (TestRl <> 9.0) do
  Begin
    WriteLn('Test for Val and Str. Enter a "9" to stop.');
    Write('Enter a number:');
    ReadLn(TestSt);
    TestRl := Val(TestSt);
    Str(TestRl,TestSt);
    WriteLn('Real number as a string:',TestSt);
  End;
End.
RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR